home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 00 / 5 / DISK0059.ZIP / PEPSON.BAS < prev    next >
BASIC Source File  |  1983-08-04  |  13KB  |  338 lines
  1. 5 WIDTH "LPT1:",180
  2. 10 LPRINT CHR$(27)"@";
  3. 20 LPRINT CHR$(27)"2";
  4. 25 LPRINT CHR$(27)"O";
  5. 30 E$=CHR$(27)
  6. 35 F6P = 0: F2P = 0: 
  7. 40 ONN$(2)=E$+CHR$(87)+CHR$(1) : OFFF$(2)=E$+CHR$(87)+CHR$(0)
  8. 50 ONN$(3)=E$+CHR$(69)         : OFFF$(3)=E$+CHR$(70)
  9. 60 ONN$(4)=E$+CHR$(52)         : OFFF$(4)=E$+CHR$(53)
  10. 70 ONN$(5)=E$+CHR$(48)         : OFFF$(5)=E$+CHR$(50)
  11. 80 ONN$(6)=E$+CHR$(70)+CHR$(15): OFFF$(6)=CHR$(18)
  12. 90 ONN$(7)=E$+CHR$(71)         : OFFF$(7)=E$+CHR$(72)
  13. 100 ONN$(8)=E$+CHR$(45)+CHR$(1): OFFF$(8)=E$+CHR$(45)+CHR$(0)
  14. 105 LPI = 6 : DOTS.INCH=216
  15. 110 INPUT "Set the printer to the top of the page. Ready";C$
  16. 112 INPUT "COMMAND INDICATOR CHARACTER";Q$
  17. 114 IF C$ ="s" THEN STD = 1 ELSE STD = 0 :INPUT "lines per inch (d=6)";LPI
  18. 115 IF LPI = 0 THEN LPI = 6
  19. 116 IF NOT LPI=6 THEN XLPL=DOTS.INCH\LPI: OFFF$(5)=E$+CHR$(51)+CHR$(XLPL): ONN$(5)=OFFF$(5)
  20. 117 PRINT XLPL: IF NOT LPI = 6 THEN LPRINT OFFF$(5);
  21. 118 LENGTH = 66: LINE.LENGTH = 68
  22. 120 IF STD = 0 THEN INPUT "How many lines per page (d=66)";LENGTH
  23. 125 IF LENGTH = 0 THEN LENGTH = 66
  24. 130 IF STD = 0 THEN INPUT "what`s the line length (d=68)";LINE.LENGTH
  25. 135 IF LINE.LENGTH = 0 THEN LINE.LENGTH = 68
  26. 170 PAGE = 1:  SECTION.C$ = " ": ZZ$="a"
  27. 180 INPUT "Do you want lettered sections (Y or N)";SECT$
  28. 190 IF NOT(SECT$="Y" OR SECT$="y") THEN SECT$="-": GOTO 250
  29. 200 INPUT "What letter should I start with?  (1=`A' 2=`B' etc.)";S.N
  30. 205 IF S.N = 0 THEN S.N = 1
  31. 210 SECTION.N = 64+S.N
  32. 220 SECTION.C$ = CHR$(SECTION.N)
  33. 230 SECT$ = " "
  34. 250 LPRINT CHR$(27)"C"CHR$(LENGTH);
  35. 255 T.START = 6: T.END = 59: PAGE.LINE = 63: M.L = 8
  36. 260 IF STD = 0 THEN INPUT "On which line does the text begin (d=6)";T.START
  37. 265 IF T.START = 0 THEN T.START = 6
  38. 270 IF STD = 0 THEN INPUT "On which line does it end (d=59) ";T.END
  39. 275 IF T.END = 0 THEN T.END = 59
  40. 280 PITCH = 10
  41. 281 IF NOT STD = 0 THEN GOTO 290
  42. 282 INPUT "How many columns for left margin (d=8)";M$
  43. 283 IF M$="" THEN M.L = 8 ELSE M.L = VAL(M$)
  44. 285 IF NOT ((LINE.LENGTH + M.L) > 78) THEN GOTO 290
  45. 286 LINE.LENGTH = LINE.LENGTH - 1
  46. 287 GOTO 285
  47. 290 PARA.INDENT = 5: CC.ON.BUF = 0
  48. 300 TLINES = T.END - T.START + 1
  49. 310 MARG.BOT = LENGTH - T.END
  50. 320 LYNE = 1
  51. 330 FOR I=0 TO 8: FLAG(I)=0: NEXT I
  52. 340 MARG.TOP = T.START - 1
  53. 350 FOR I=1 TO MARG.TOP
  54. 360 LYNE = LYNE + 1 :LPRINT
  55. 370 NEXT I
  56. 380 MODE = 1: TEXT.COUNT = 0: BUFFER$ = "": LAST.TEXT$ = " "
  57. 385 T.IN.LINE = 0: L.ON = 1
  58. 390 IF STD = 0 THEN INPUT "On which line do you want the page numbers";PAGE.LINE
  59. 400 INPUT "What is the name of your file"; FILE$
  60. 410 '
  61. 420 OPEN FILE$ FOR INPUT  AS #1
  62. 430 '
  63. 440 '
  64. 460 ' SUBROUTINE NEW-LINE
  65. 470 '
  66. 480 IF EOF(1) THEN GOSUB 1360:GOSUB 1570: CLOSE: LPRINT CHR$(27)"@":END
  67. 490 CC.CODE = 1
  68. 500 LINE INPUT  #1,C$
  69. 510 LEN.C = LEN(C$)
  70. 520 IF NOT (LEN.C=0) THEN GOTO 550
  71. 530 IF FLAG (0) = 1 THEN GOSUB 1360
  72. 540 GOTO 460
  73. 550 LASTC$=RIGHT$(C$,1)
  74. 560 IF LASTC$ = " " THEN C$=LEFT$(C$,LEN.C-1): GOTO 510
  75. 570 FIRSTC$=LEFT$(C$,1)
  76. 580 IF (FLAG(0)=1) OR (NOT(FIRSTC$=" ")) THEN GOTO 620
  77. 590 LEN.C = LEN(C$)
  78. 600 C$ = RIGHT$(C$,LEN.C -1)
  79. 610 IF LEN.C =1 THEN GOTO 460 ELSE GOTO 570
  80. 620 IF FIRSTC$=Q$ THEN GOSUB 670 ELSE  GOSUB 760
  81. 630 IF NOT(LEN(C$) = 0) THEN GOTO 570
  82. 640 IF FLAG(0) = 1 THEN GOSUB 1360
  83. 650 GOTO 460
  84. 660 '
  85. 670 ' Subroutine control character
  86. 680 '
  87. 690 L.LEN = LEN(C$)
  88. 700 CC.CHAR$=MID$(C$,2,1)
  89. 705 IF CC.CHAR$=" " THEN GOTO 742
  90. 710 L.LEN = L.LEN -2
  91. 720 IF L.LEN>0 THEN C$=RIGHT$(C$,L.LEN) ELSE C$="" '  removes control character
  92. 730  GOSUB 1810  ' send control char to buffer
  93. 740 RETURN
  94. 741 '  here is a literal "!". keep it as text.
  95. 742 E.MARK$ = LEFT$(C$,2)
  96. 743 BUFFER$=BUFFER$ + E.MARK$
  97. 744 TEXT.COUNT = TEXT.COUNT + 2
  98. 745 L.LEN = L.LEN - 2
  99. 746 IF L.LEN>0 THEN C$=RIGHT$(C$,L.LEN) ELSE C$="" '  removes control character
  100. 747 RETURN
  101. 750 '
  102. 760 ' Subroutine accumulate good text from line
  103. 770 '
  104. 780 L.LEN = LEN (C$)
  105. 790 FOR I=1 TO L.LEN
  106. 800 IF MID$(C$,I,1) = Q$ THEN GOTO 870
  107. 810 NEXT I
  108. 820 TEXT$=C$
  109. 830 IF FLAG(1) = 1 THEN C$ = "":  RETURN '  if this is a centering line...
  110. 840 GOSUB 950' send text to buffer
  111. 850 C$=""
  112. 860 RETURN
  113. 870 ' (there's a cc.char in the string...)
  114. 880 TEXT$=LEFT$(C$,I-1)
  115. 890 L.LEN = L.LEN -I+1
  116. 900 C$=RIGHT$(C$,L.LEN)
  117. 910 IF FLAG(1) = 1 THEN RETURN
  118. 920 GOSUB 950'  send text to buffer
  119. 930 RETURN
  120. 940 '
  121. 950 'Subroutine text buffer
  122. 960 '
  123. 970 IF (TEXT.COUNT + (LEN(TEXT$)*10/PITCH) > LINE.LENGTH - 1) THEN GOTO 1070
  124. 980 TEXT.COUNT = TEXT.COUNT + (LEN(TEXT$)*10/PITCH)' add text to buffer
  125. 990 IF (LAST.TEXT$ = " " AND LEFT$(TEXT$,1) = " " AND FLAG(0)=0) THEN                   TEXT$ = RIGHT$(TEXT$,LEN(TEXT$) -1): ELSE GOTO 1010
  126. 1000 GOTO 990
  127. 1010 IF NOT (LAST.TEXT$ = " " OR LEFT$(TEXT$,1) = " ") THEN                        BUFFER$=BUFFER$ + SPACE$(1): TEXT.COUNT = TEXT.COUNT + PITCH/10
  128. 1020 BUFFER$=BUFFER$+TEXT$: T.IN.LINE = 1
  129. 1030 LAST.TEXT$= RIGHT$(BUFFER$,1)
  130. 1040 TEXT$ = ""
  131. 1050 RETURN' buffer isn't full yet.
  132. 1060 '
  133. 1070 GOSUB 1180 'find the max amount of text that fits
  134. 1080 IF NOT(LAST.TEXT$=" " OR LEFT$(MAX.TEXT$,1) = " ") THEN                            BUFFER$=BUFFER$ + SPACE$(1)
  135. 1090 BUFFER$=BUFFER$ + MAX.TEXT$: T.IN.LINE =1'--fill the buffer with amap
  136. 1100 LAST.TEXT$ = RIGHT$(BUFFER$,1)
  137. 1110 GOSUB 1360: L.ON = 0
  138. 1120 IF NOT(LYNE > T.END) THEN GOTO 1140
  139. 1130 GOSUB 1570: GOSUB 1710
  140. 1140 IF LEN(TEXT$) >0 THEN GOTO 970
  141. 1150 RETURN
  142. 1160 ' end text buffer
  143. 1170 '
  144. 1180 'Subroutine find the max amount of text that fits
  145. 1200 SPACE = LINE.LENGTH - TEXT.COUNT'-- this is the space available at EOL
  146. 1210 SPACE = SPACE * PITCH/10
  147. 1215 IF FLAG(0) = 1 THEN GOTO 1280
  148. 1220 FOR I=SPACE TO 1 STEP -1'   ----------\
  149. 1230 M$=MID$(TEXT$,I,1)
  150. 1240 IF M$=" " OR M$= "-" THEN GOTO 1320'  >- find a blank in the string
  151. 1250 NEXT I' ------------------------------/
  152. 1260 MAX.TEXT$= ""
  153. 1270 IF FLAG(0)=0 THEN RETURN
  154. 1280 MAX.TEXT$=TEXT$
  155. 1290 PRINT "pre-formatted line is too long." TEXT$
  156. 1300 INPUT "continue";Z$
  157. 1310 TEXT$ = "": RETURN
  158. 1320 MAX.TEXT$=LEFT$(TEXT$,I)'---this is as much as can be added to buffer
  159. 1330 TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-I)'--this is what's left.
  160. 1340 RETURN
  161. 1350 '
  162. 1360 ' Subroutine print buffer and initialize it again
  163. 1370 '
  164. 1380 IF (FLAG(1)=1 OR FLAG(0)=1) THEN BLANKS=M.L ELSE BLANKS = INDENT+M.L
  165. 1382 DS$ = "": IF F2P=1 THEN DS$ = DS$ + ONN$(2)
  166. 1384           IF F6P=1 THEN DS$ = DS$ + ONN$(6)
  167. 1386 DSO$="": IF F2P=1 THEN DSO$ = DSO$ + OFFF$(2)
  168. 1388          IF F6P=1 THEN DSO$ = DSO$ + OFFF$(6)
  169. 1400 LPRINT DSO$;SPACE$(BLANKS);DS$; BUFFER$
  170. 1410 BUFFER$="": CC.ON.BUF = 0: T.IN.LINE = 0
  171. 1420 LAST.TEXT$ = " ": CENTER = 0
  172. 1430 IF FLAG(0)=1 OR FLAG(1)=1 THEN TEXT.COUNT = 0 ELSE TEXT.COUNT = INDENT
  173. 1440 LYNE = LYNE + 1
  174. 1445 F6P = FLAG(6): F2P = FLAG(2)
  175. 1450 IF NOT(LYNE > T.END) THEN RETURN
  176. 1460 IF P.END = 1 THEN P.END =0: RETURN   ELSE GOSUB 1570: GOSUB 1710
  177. 1470 RETURN
  178. 1480 '
  179. 1490 '
  180. 1500 'Subroutine stick control character on buffer
  181. 1510 '
  182. 1520 IF FLAG(CODE.NUMBER)=1 THEN BUFFER$=BUFFER$ + ONN$(CODE.NUMBER)                    ELSE BUFFER$ = BUFFER$ + OFFF$(CODE.NUMBER)
  183. 1530 CC.ON.BUF = CC.ON.BUF + 3
  184. 1540 RETURN
  185. 1550 '
  186. 1560 '
  187. 1570 'Subroutine go to the top of the next page
  188. 1580 '
  189. 1590 IF LYNE > T.END THEN GOTO  1640' take care of new page
  190. 1600 TOSKIP = T.END - LYNE
  191. 1610 FOR I=1 TO TOSKIP : LPRINT
  192. 1620 LYNE = LYNE + 1
  193. 1630 NEXT I
  194. 1640 FOR I = 1 TO MARG.BOT
  195. 1650 IF LYNE = PAGE.LINE THEN GOSUB 2870 ELSE LPRINT : LYNE=LYNE+1
  196. 1660 NEXT I
  197. 1670 PAGE = PAGE + 1
  198. 1680 RETURN
  199. 1690 '
  200. 1700 '
  201. 1710 ' subroutine top of new page
  202. 1720 IF NOT (ZZ$="") THEN INPUT "new page. ready?";ZZ$
  203. 1730 LYNE = 1
  204. 1740 FOR I = 1 TO MARG.TOP
  205. 1750 IF I= PAGE.LINE THEN GOSUB 2870 ELSE LPRINT :LYNE=LYNE+1
  206. 1760 NEXT I
  207. 1770 RETURN
  208. 1780 'END  (newpage)
  209. 1790 '
  210. 1800 '
  211. 1810 'Subroutine special code mode
  212. 1820 '
  213. 1830 IF NOT(CC.CHAR$= "*") THEN GOTO 1870
  214. 1840 IF TEXT.COUNT > 0 THEN GOSUB 1360
  215. 1850 IF FLAG(0) = 1 THEN FLAG(0) = 0:L.ON =1: ELSE FLAG(0) = 1: L.ON = 0
  216. 1860  RETURN
  217. 1870 V = VAL (CC.CHAR$)
  218. 1880 IF CC.CHAR$ = "0" THEN GOTO 1900
  219. 1890 IF NOT (0 < V  AND V < 7) THEN GOTO 1930' \___ handle indentation
  220. 1900 IF TEXT.COUNT > 0 THEN GOSUB 1360: L.ON = 1
  221. 1910 INDENT = 5 * VAL(CC.CHAR$)
  222. 1920 TEXT.COUNT = INDENT*10/PITCH  : RETURN
  223. 1930 IF NOT(CC.CHAR$ = "p" OR CC.CHAR$ = "P") THEN GOTO 1990
  224. 1940 IF T.IN.LINE = 1 THEN GOSUB 1360 :L.ON=0 :ELSE GOTO 1970
  225. 1950    BUFFER$ = BUFFER$ + SPACE$(PARA.INDENT)
  226. 1960    TEXT.COUNT = PARA.INDENT * 10/PITCH + TEXT.COUNT: RETURN
  227. 1970 'IF L.ON = 1  THEN GOSUB 1360
  228. 1980 'L.ON = 1
  229. 1985 GOTO 1950
  230. 1990 IF NOT(CC.CHAR$ = "L" OR CC.CHAR$="l") THEN GOTO 2020
  231. 2000 IF T.IN.LINE = 1 OR L.ON = 1 THEN GOSUB 1360
  232. 2010 L.ON = 1 : RETURN
  233. 2020 IF NOT (CC.CHAR$="!") THEN GOTO 2060
  234. 2030 IF TEXT.COUNT > INDENT THEN GOSUB 1360
  235. 2040 GOSUB 1570: GOSUB 1710
  236. 2050 L.ON = 1: RETURN
  237. 2060 IF NOT (CC.CHAR$="?") THEN GOTO 2100
  238. 2070 LINES.LEFT = T.END-LYNE
  239. 2080 IF LINES.LEFT < 10 THEN RETURN ELSE GOTO 2030
  240. 2090 RETURN
  241. 2100 IF NOT (CC.CHAR$="C" OR CC.CHAR$="c") THEN GOTO 2120 ELSE GOSUB 2270
  242. 2110  RETURN 'special code mode
  243. 2120 IF NOT (CC.CHAR$="$") THEN GOSUB 2460 ELSE GOSUB 2160
  244. 2130 RETURN
  245. 2140 '
  246. 2150 '
  247. 2160 'Subroutine next section
  248. 2170 '
  249. 2180 IF SECT$= "-" THEN RETURN
  250. 2190 GOSUB 1570
  251. 2200 PAGE = 1
  252. 2210 SECTION.N = SECTION.N + 1
  253. 2220 SECTION.C$ = CHR$(SECTION.N)
  254. 2230 GOSUB 1710
  255. 2240 RETURN
  256. 2250 '
  257. 2260 '
  258. 2270 ' Subroutine center the line
  259. 2280 '
  260. 2290 COLS = PITCH * (LINE.LENGTH/10)
  261. 2295 'IF CENTER = 1 THEN GOTO 2310
  262. 2300 IF T.IN.LINE > 0 THEN GOSUB 1360: L.ON =0'-- print the buffer
  263. 2305 IF CENTER = 1 THEN GOTO 2310
  264. 2310 TEXT.COUNT = 0
  265. 2320 FLAG(1) = 1
  266. 2330 GOSUB 760'---get text up to next Q$
  267. 2340 IF LEN(TEXT$) > LINE.LENGTH  THEN GOSUB 1180                                            ELSE MAX.TEXT$ = TEXT$ : TEXT$ = ""
  268. 2350 TOSKIP = (COLS -LEN(MAX.TEXT$))/2 '  compute leading blanks
  269. 2360 BUFFER$ = BUFFER$ + SPACE$(TOSKIP) '  add the blanks to buffer
  270. 2370 BUFFER$ = BUFFER$ + MAX.TEXT$: T.IN.LINE = 1'---add text to buffer
  271. 2380 LAST.TEXT$ = " "
  272. 2390 GOSUB 1360'-- print the line
  273. 2400 IF LEN(TEXT$)>0 THEN GOTO 2340
  274. 2410 FLAG(1) =0 : L.ON = 1: CENTER=1
  275. 2420 RETURN
  276. 2430 END' (SUBROUTINE SPECIAL CODE MODE)
  277. 2440 '
  278. 2450 '
  279. 2460 'Subroutine decode cc.char and send codes to buffer
  280. 2470 '
  281. 2480 IF NOT(CC.CHAR$="@") THEN GOTO 2530
  282. 2490 FOR I = 2 TO 8
  283. 2500    FLAG(I) = 0: BUFFER$ = BUFFER$ + OFFF$(I)
  284. 2510    NEXT I
  285. 2520    GOTO 2810
  286. 2530 IF NOT (CC.CHAR$="E" OR CC.CHAR$="e") THEN GOTO 2560                                 ELSE IF (CC.CHAR$="E") THEN FLAG(3) = 1  ELSE FLAG(3) = 0
  287. 2540 CODE.NUMBER = 3:  GOSUB 1490'  get buffer fixed
  288. 2550                            GOTO 2810
  289. 2560 IF NOT (CC.CHAR$="D" OR CC.CHAR$="d") THEN GOTO 2590                                ELSE IF (CC.CHAR$="D") THEN FLAG(2) = 1  ELSE FLAG(2) = 0
  290. 2570 CODE.NUMBER = 2: GOSUB 1490'  get buffer fixed
  291. 2580                            GOTO 2810
  292. 2590 IF NOT (CC.CHAR$="I" OR CC.CHAR$="i") THEN GOTO 2620                                ELSE IF (CC.CHAR$="I") THEN FLAG(4) = 1  ELSE FLAG(4) = 0
  293. 2600 CODE.NUMBER = 4: GOSUB 1490'  get buffer fixed
  294. 2610                            GOTO 2810
  295. 2620 IF NOT (CC.CHAR$="N" OR CC.CHAR$="n") THEN GOTO 2650                                ELSE IF (CC.CHAR$="N") THEN FLAG(5) = 1   ELSE FLAG(5) = 0
  296. 2630 CODE.NUMBER = 5: GOSUB 1490' get buffer fixed
  297. 2640                            GOTO 2810
  298. 2650 IF NOT (CC.CHAR$="T" OR CC.CHAR$="t") THEN GOTO 2680                                ELSE IF (CC.CHAR$="T") THEN FLAG(7) = 1 ELSE FLAG(7) = 0
  299. 2660 CODE.NUMBER = 7: GOSUB 1490' get buffer fixed
  300. 2670                            GOTO 2810
  301. 2680 IF NOT (CC.CHAR$="U" OR CC.CHAR$="u") THEN GOTO 2710                                ELSE IF (CC.CHAR$="U") THEN FLAG(8) = 1 ELSE FLAG(8) = 0
  302. 2690 CODE.NUMBER = 8: GOSUB 1490' get buffer fixed
  303. 2700                            GOTO 2810
  304. 2710 IF NOT (CC.CHAR$="S" OR CC.CHAR$="s") THEN GOTO 2740                                ELSE IF (CC.CHAR$="S") THEN FLAG(6) = 1 ELSE FLAG(6) = 0
  305. 2720 CODE.NUMBER = 6: GOSUB 1490' get buffer fixed
  306. 2730                            GOTO 2810
  307. 2740 IF NOT (CC.CHAR$="X")THEN FLAG(9)=0: GOTO 2790 ELSE FLAG(9)=1
  308. 2750 XC$=LEFT$(C$,2) : LEN.C = LEN(C$) - 2 : C$ = RIGHT$(C$,LEN.C)
  309. 2760 XX = VAL (XC$)
  310. 2770 BUFFER$=BUFFER$ + CHR$(XX)
  311. 2780 RETURN
  312. 2790 PRINT "I don't recognize this print control character: ";CC.CHAR$
  313. 2800 RETURN
  314. 2810 '
  315. 2820 PITCH = 10
  316. 2830 IF FLAG(6) = 1 THEN PITCH =  17
  317. 2840 IF FLAG(2) = 1 THEN PITCH = 5
  318. 2850 RETURN
  319. 2860 '
  320. 2870 ' PAGENUMBER
  321. 2880 '
  322. 2890 P.END = 1
  323. 2900 FOR J = 2 TO 8: BUFFER$= BUFFER$ + OFFF$(J): NEXT J
  324. 2910 PN = LINE.LENGTH /2 - 2
  325. 2920 BUFFER$=BUFFER$ + SPACE$(PN)
  326. 2930 BUFFER$=BUFFER$ + ONN$(3)+ONN$(7)+SECTION.C$ +" -" + STR$(PAGE)+SECT$
  327. 2940 GOSUB 2980
  328. 2950 BLANKS = 8: GOSUB 1400' PRINT BUFFER OUT AND EMPTY
  329. 2960 RETURN
  330. 2970 '
  331. 2980 ' Subroutine reset old cc.codes in new buffer
  332. 2990 '
  333. 3000 FOR K=2 TO 8
  334. 3010    IF FLAG(K) = 1 THEN BUFFER$ = BUFFER$ + ONN$(K)                                    ELSE BUFFER$ = BUFFER$ + OFFF$(K)
  335. 3020 NEXT K
  336. 3030 RETURN
  337. EN BUFFER$ = BUFFER$ + ONN$(K)                                    ELSE BUFFER$ = BUFFER$ + OFFF$(K)
  338. 3020 N